Dr. Windows 3/dr win3.zip/dr win3/PROGRAMR/SPMATE13.ZIP/GETFILE.FR$/getfile.frm

Text File | 1993-07-09 | 6KB | 226 lines

VERSION 2.00
Begin Form GetFile
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Select a File"
   Height          =   3885
   Icon            =   0
   Left            =   1005
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   3510
   ScaleWidth      =   6285
   Top             =   1200
   Width           =   6375
   Begin DriveListBox Drive1
      Height          =   315
      Left            =   4785
      TabIndex        =   3
      Top             =   1800
      Width           =   1215
   End
   Begin DirListBox Dir1
      Height          =   1815
      Left            =   2280
      TabIndex        =   2
      Top             =   1455
      Width           =   2265
   End
   Begin FileListBox File1
      Height          =   2175
      Left            =   240
      TabIndex        =   1
      Top             =   1080
      Width           =   1800
   End
   Begin CommandButton Command2
      Caption         =   "Cancel"
      Height          =   375
      Left            =   4935
      TabIndex        =   5
      Top             =   720
      Width           =   1095
   End
   Begin CommandButton Command1
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   4935
      TabIndex        =   4
      Top             =   240
      Width           =   1095
   End
   Begin TextBox Text1
      Height          =   315
      Left            =   1200
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   240
      Width           =   3495
   End
   Begin Label Label5
      AutoSize        =   -1  'True
      Caption         =   "Drives:"
      Height          =   195
      Left            =   4785
      TabIndex        =   8
      Top             =   1575
      Width           =   615
   End
   Begin Label Label4
      AutoSize        =   -1  'True
      Caption         =   "Directories:"
      Height          =   195
      Left            =   2280
      TabIndex        =   7
      Top             =   1200
      Width           =   990
   End
   Begin Label Label3
      AutoSize        =   -1  'True
      Caption         =   "Files:"
      Height          =   195
      Left            =   240
      TabIndex        =   10
      Top             =   840
      Width           =   465
   End
   Begin Label Label1
      AutoSize        =   -1  'True
      Height          =   195
      Left            =   2160
      TabIndex        =   6
      Top             =   750
      Width           =   2055
   End
   Begin Label Label2
      AutoSize        =   -1  'True
      Caption         =   "File Name:"
      Height          =   195
      Left            =   240
      TabIndex        =   9
      Top             =   240
      Width           =   915
   End
End
'Declarations for GETFILE.FRM

Const TEXTFLAG = 0
Const FILEFLAG = 1
Const DIRFLAG = 2

Dim SelectFlag As Integer

Sub Command1_Click ()
   On Error GoTo ErrorTrap

   If SelectFlag = TEXTFLAG Then
      File1.FileName = Text1.Text
      If FileSelected = True Then
         On Error GoTo 0
         Unload GetFile
         Exit Sub
      End If
      Dir1.Path = File1.Path
   ElseIf SelectFlag = DIRFLAG Then
      Dir1.Path = Dir1.List(Dir1.ListIndex)
      Dir1_Change
   Else
      If Right$(Dir1.Path, 1) = "\" Then
         FullFilePath = Dir1.Path + Text1.Text
      Else
         FullFilePath = Dir1.Path + "\" + Text1.Text
      End If
      FileSelected = True
      Unload GetFile
   End If
   Exit Sub

ErrorTrap:
   Beep
   Resume Next
End Sub

Sub Command2_Click ()
   Unload GetFile
End Sub

Sub Dir1_Change ()
   FillLabel1
   File1.FileName = Dir1.Path + "\" + File1.Pattern
   Drive1.Drive = Dir1.Path
   Text1.Text = File1.Pattern
   SelectFlag = DIRFLAG
End Sub

Sub Dir1_Click ()
   SelectFlag = DIRFLAG
End Sub

Sub Drive1_Change ()
   Dir1.Path = Drive1.Drive
   Text1.Text = File1.Pattern
   SelectFlag = DIRFLAG
End Sub

Sub File1_Click ()
   Text1.Text = File1.FileName
   SelectFlag = FILEFLAG
End Sub

Sub File1_DblClick ()
   If SelectFlag = TEXTFLAG Then
      FullFilePath = File1.Path + "\" + File1.FileName
   Else
      If Right$(Dir1.Path, 1) = "\" Then
         FullFilePath = Dir1.Path + Text1.Text
      Else
         FullFilePath = Dir1.Path + "\" + Text1.Text
      End If
   End If

   FileSelected = True
   Unload GetFile
End Sub

Sub FillLabel1 ()
   Label1.Caption = Dir1.Path
   If Label1.Width > 2055 Then
      a$ = Left$(Dir1.Path, 3)
      b$ = Mid$(Dir1.Path, 4)
      Do While InStr(b$, "\")
         b$ = Mid$(b$, InStr(b$, "\") + 1)
      Loop
      Label1.Caption = a$ + "...\" + b$
   End If
End Sub

Sub Form_Load ()
   GetFile.Left = (Screen.Width - GetFile.Width) / 2
   GetFile.Top = (Screen.Height - GetFile.Height) / 2

   If FullFilePath <> "" Then
      Tmp$ = FullFilePath
      Do Until Right$(Tmp$, 1) = "\"
         Tmp$ = Left$(Tmp$, Len(Tmp$) - 1)
      Loop
      Tmp$ = Tmp$ + WILDCARD$
      File1.FileName = Tmp$
      Dir1.Path = File1.Path
   End If

   File1.Pattern = WILDCARD$
   FillLabel1
   Text1.Text = File1.Pattern
   SelectFlag = DIRFLAG
   FileSelected = False
End Sub

Sub Form_Resize ()
   Text1.SetFocus
End Sub

Sub Text1_Change ()
   SelectFlag = TEXTFLAG
End Sub